home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagn_r.zip / PRINTING.SWG / 0025_Graphics Dump to Laser.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-02  |  3KB  |  140 lines
  1. {
  2. > I wrote a computer Program that produces 8 bit 480 x 640 hi res images,
  3. > and I would like to know if anyone is familiar With a routine that can
  4. > print these images out on a Printer.
  5. > The preferable Printer For the task is a HP LaserJet II.
  6. >
  7. > I would like to be able to tell the LaserJet exactly which pixel dots
  8. > to print, and I don't mind if I have to give bit information to the
  9. > Printer line-by-line.
  10. >
  11.  
  12. Below is some (old) code to make a screendump in Graphics mode, for
  13. both HP laser II and Epson. I haven't tested this For SVGA, but if
  14. you give MaxX and MaxY the right values, I can't see where it would
  15. go wrong.
  16.  
  17. Jan Barendregt
  18. }
  19. Uses
  20.   Graph,
  21.   Dos,
  22.   Printer;
  23.  
  24. Const
  25.   d = 'l';
  26.  
  27. Var
  28.   MaxX, MaxY : Integer;
  29.  
  30. Procedure dump;
  31. Var
  32.   ymax,
  33.   bbyt,
  34.   b2   : Byte;
  35.   psf  : File of Byte;
  36.   regs : Registers;
  37.  
  38.   Procedure out(ch : Char);
  39.   begin
  40.     regs.ax := ord(ch);
  41.     regs.dx := 0;
  42.     intr($17, regs);
  43.   end;
  44.  
  45.   Procedure hplaser;
  46.   Var
  47.     b,
  48.     reg,
  49.     kol : Word;
  50.   begin
  51.     assign(psf, 'lpt1');
  52.     reWrite(psf);
  53.     Write(lst, chr(27), 'E');
  54.     Write(lst, chr(27), '*t100R', chr(27), '*r0A');
  55.     For reg := 0 to maxx do
  56.     begin
  57.       Write(lst, chr(27), '*b', (maxy + 1) div 8, 'W');
  58.       For kol := ((maxy + 1) div 8) - 1 downto 0 do
  59.       begin
  60.         bbyt := 0;
  61.         For b := 0 to 7 do
  62.         begin
  63.           if getpixel(reg, kol * 8 + b) = 0 then
  64.             b2 := 0
  65.           else
  66.             b2 := 1;
  67.           bbyt := bbyt or (b2 shl b);
  68.         end;
  69.         out(chr(bbyt));
  70.       end;
  71.     end;
  72.     Write(lst, chr(27), '*rB');
  73.     Write(lst, chr(12));
  74.     Write(lst, chr(27), 'E');
  75.     close(psf);
  76.   end;
  77.  
  78.   Procedure epson;
  79.   Var
  80.     k, j, i : Byte;
  81.  
  82.     Function xget(x, y : Integer) : Byte;
  83.     begin
  84.       regs.ah := $0D;
  85.       regs.cx := x;
  86.       regs.dx := y;
  87.       intr(16, regs);
  88.       xget := regs.al;
  89.     end;
  90.  
  91.   begin
  92.     out(chr($1B));
  93.     out(chr($33));
  94.     out(chr($18));
  95.     out(chr($0D));
  96.     out(chr($0A));
  97.     For j := 0 to (maxy shr 3) do
  98.     begin
  99.       out(chr($1B));
  100.       out(chr($4C));
  101.       out(chr((maxx + 1) mod 256));
  102.       out(chr((maxx + 1) div 256));
  103.       For i := 0 to maxx do
  104.       begin
  105.         bbyt := 0;
  106.         For k := 0 to 7 do
  107.           if (xget(i, (j shl 3) + k) <> 0) then
  108.             bbyt := bbyt or (128 shr k);
  109.         out(chr(bbyt));
  110.       end;
  111.       out(chr(13));
  112.       out(chr(10));
  113.     end;
  114.   end;
  115.  
  116. begin
  117.   MaxX := GetMaxX;
  118.   MaxY := GetMaxY;
  119.  
  120.   if d = 'l' then
  121.     hplaser
  122.   else
  123.     epson;
  124. end;
  125.  
  126.  
  127. Var
  128.   Gd, Gm,
  129.   Radius : Integer;
  130.  
  131. begin
  132.   Gd := Detect;
  133.   InitGraph(Gd, Gm, 'e:\bp\bgi');
  134.   For Radius := 1 to 5 do
  135.     Circle(100, 100, Radius * 10);
  136.   Readln;
  137.   Dump;
  138.   CloseGraph;
  139. end.
  140.